!
! Copyright (C) 1991-2004  ; All Rights Reserved ; Colorado State University
! Colorado State University Research Foundation ; ATMET, LLC
! 
! This file is free software; you can redistribute it and/or modify it under the
! terms of the GNU General Public License as published by the Free Software 
! Foundation; either version 2 of the License, or (at your option) any later version.
! 
! This software is distributed in the hope that it will be useful, but WITHOUT ANY 
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A 
! PARTICULAR PURPOSE.  See the GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License along with this 
! program; if not, write to the Free Software Foundation, Inc., 
! 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!===============================================================================!############################# Change Log ##################################
! 5.0.0
!
!###########################################################################

subroutine node_sendlbc()

  use mem_grid, only: &
       ngrid            !INTENT(IN)

  use node_mod, only: &
       mynum,         & !INTENT(IN)
       nmachs,        & !INTENT(IN)
       machs,         & !INTENT(IN)
       iget_paths,    & !INTENT(IN)
       ipaths,        & !INTENT(IN)
       node_buffs,    & !INTENT(INOUT)
       f_ndmd_size,   & !INTENT(IN)
       irecv_req,     & !INTENT(INOUT)
       isend_req,     & !INTENT(INOUT)
       mzp, mxp, myp, & !INTENT(IN)
       i0, j0           !INTENT(IN)

  use var_tables, only: &
       num_var,         & !INTENT(IN)
       vtab_r             !INTENT(IN)

  use mem_scratch, only: &
       scratch            !INTENT(OUT)

  implicit none
  ! Local Variables:
  integer :: ierr, ipos, itype, nm, i1, i2, j1, j2, nv, mtp, tag, max_send_buff

  itype=1
  !______________________
  !
  !   First, before we send anything, let's post the receives. Also, make sure
  !     any pending sends are complete.

  tag = 200+ngrid

  do nm=1,nmachs
     if (iget_paths(itype,ngrid,nm)/=0) then
        call parf_get_noblock(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, machs(nm), &
             tag, irecv_req(nm))
     endif
  enddo

  !______________________
  !
  !   Now we can actually go on to sending the stuff

  do nm=1,nmachs

     if(ipaths(1,itype,ngrid,nm)/=0) then

        i1=ipaths(1,itype,ngrid,nm)
        i2=ipaths(2,itype,ngrid,nm)
        j1=ipaths(3,itype,ngrid,nm)
        j2=ipaths(4,itype,ngrid,nm)

        ipos = 1
        max_send_buff = node_buffs(nm)%nsend*f_ndmd_size
        call parf_pack_int(i1, 1, node_buffs(nm)%lbc_send_buff(1), &
             max_send_buff, ipos)
        call parf_pack_int(i2, 1, node_buffs(nm)%lbc_send_buff(1), &
             max_send_buff, ipos)
        call parf_pack_int(j1, 1, node_buffs(nm)%lbc_send_buff(1), &
             max_send_buff, ipos)
        call parf_pack_int(j2, 1, node_buffs(nm)%lbc_send_buff(1), &
             max_send_buff, ipos)
        call parf_pack_int(mynum, 1, node_buffs(nm)%lbc_send_buff(1), &
             max_send_buff, ipos)

        do nv = 1, num_var(ngrid)
           if (vtab_r(nv,ngrid)%impt1==1) then
              if (vtab_r(nv,ngrid)%idim_type==3) then
                 call mkstbuff(mzp, mxp, myp, vtab_r(nv,ngrid)%var_p, &
                      scratch%vt3dp(1), i1-i0, i2-i0, j1-j0, j2-j0, mtp)
              elseif (vtab_r(nv,ngrid)%idim_type==2) then
                 call mkstbuff(1, mxp, myp, vtab_r(nv,ngrid)%var_p, &
                      scratch%vt3dp(1), i1-i0, i2-i0, j1-j0, j2-j0, mtp)
              endif
              call parf_pack_real(scratch%vt3dp(1), mtp, &
                   node_buffs(nm)%lbc_send_buff(1), &
                   max_send_buff, ipos)
           endif
        enddo

        call parf_send_noblock(node_buffs(nm)%lbc_send_buff(1), ipos-1, &
             ipaths(5,itype,ngrid,nm), tag, isend_req(nm))
     endif

  enddo

end subroutine node_sendlbc

!     ****************************************************************

subroutine node_getlbc()

  use mem_grid, only: &
       ngrid,         & !INTENT(IN)
       nnzp             !INTENT(IN)

  use node_mod, only: &
       nmachs,        & !INTENT(IN)
       iget_paths,    & !INTENT(IN)
       ipaths,        & !INTENT(IN)
       node_buffs,    & !INTENT(INOUT)
       f_ndmd_size,   & !INTENT(IN)
       irecv_req,     & !INTENT(INOUT)
       isend_req,     & !INTENT(INOUT)
       mzp, mxp, myp, & !INTENT(IN)
       i0, j0           !INTENT(IN)

   use var_tables, only: &
       num_var,         & !INTENT(IN)
       vtab_r             !INTENT(IN)

  use mem_scratch, only: &
       scratch            !INTENT(OUT)

  implicit none
  ! Local Variables:
  integer :: ierr, ipos, itype, nm, ibytes, msgid, ihostnum, i1, i2, j1, j2, &
            nmp, nv, node_src, mtc, mtp, nptsxy, wmzp


  itype=1

  !_____________________________________________________________________
  !
  !  First, let's make sure our sends are all finished and de-allocated


  do nm=1,nmachs
     if(ipaths(1,itype,ngrid,nm).ne.0) then
        call parf_wait_nostatus(isend_req(nm))
     endif
  enddo

  !_____________________________________________________________________
  !
  !  Now, let's wait on our receives

  do nm=1,nmachs
     if (iget_paths(itype,ngrid,nm).ne.0) then
        call parf_wait_nostatus(irecv_req(nm))
     endif
  enddo

  !_____________________________________________________________________
  !
  !  We got all our stuff. Now unpack it into appropriate space.

  do nm=1,nmachs

     if (iget_paths(itype,ngrid,nm).ne.0) then

        ipos = 1
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, i1, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, i2, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, j1, 1)
        call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, j2, 1)
       call parf_unpack_int(node_buffs(nm)%lbc_recv_buff(1), &
             node_buffs(nm)%nrecv*f_ndmd_size, ipos, node_src, 1)

        nptsxy=(i2-i1+1)*(j2-j1+1)

        do nv = 1,num_var(ngrid)
           if ( vtab_r(nv,ngrid)%impt1 == 1) then
              if ( vtab_r(nv,ngrid)%idim_type == 3) then

                 mtp  = nptsxy * nnzp(ngrid)
                 wmzp = mzp

              elseif ( vtab_r(nv,ngrid)%idim_type == 2) then

                 mtp  = nptsxy
                 wmzp = 1

              endif

              call parf_unpack_real(node_buffs(nm)%lbc_recv_buff(1), &
                   node_buffs(nm)%nrecv*f_ndmd_size, ipos, &
                   scratch%vt3dp(1), mtp)
              call exstbuff(wmzp, mxp, myp, vtab_r(nv,ngrid)%var_p, &
                   scratch%vt3dp(1), (i1-i0), (i2-i0), (j1-j0), (j2-j0), mtc)

           endif
        enddo
        
     endif

  enddo

  return
end subroutine node_getlbc
